home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / map.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  1.0 KB  |  49 lines  |  [TEXT/MPS ]

  1. (* Association tables over ordered types *)
  2.  
  3. #open "int";;
  4. #open "eq";;
  5. #open "list";;
  6. #open "baltree";;
  7.  
  8. type ('a, 'b) binding =
  9.   { key: 'a; data: 'b; prev: 'b list };;
  10.  
  11. type ('a, 'b) t =
  12.   { tree: ('a, 'b) binding baltree__t;
  13.     order: 'a -> ('a, 'b) binding -> int };;
  14.  
  15. let empty ord =
  16.   { tree = Empty; order = fun x y -> ord x y.key };;
  17.  
  18. let bind x y b =
  19.   Something
  20.     { key = x;
  21.       data = y;
  22.       prev = match b with Nothing -> [] | Something b -> b.data :: b.prev };;
  23.  
  24. let add x y m =
  25.   { tree = baltree__modify (m.order x) (bind x y) m.tree;
  26.     order = m.order };;
  27.  
  28. let find x m =
  29.   (baltree__find (m.order x) m.tree).data;;
  30.  
  31. let unbind = function
  32.     Something({prev = x::l} as b) ->
  33.       Something { key = b.key; data = x; prev = l }
  34.   | _ -> Nothing;;
  35.  
  36. let remove x m =
  37.   { tree = baltree__modify (m.order x) unbind m.tree;
  38.     order = m.order };;
  39.  
  40. let iter f m =
  41.   let rec iter = function
  42.     Empty -> ()
  43.   | Node(l, b, r, _) ->
  44.       iter l;
  45.       f b.key b.data;
  46.       do_list (f b.key) b.prev;
  47.       iter r
  48.   in iter m.tree;;
  49.